home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
DB_CLIPP
/
0828.ZIP
/
DEXPERT.ZIP
/
TRAINING.PRG
< prev
Wrap
Text File
|
1987-02-06
|
9KB
|
366 lines
* System....: Training
* Procedure File..:TRAINING.prg
* Author........:Brian Corll
* Date:.......02/04/87
* Notice......Copyright 1987, the Author
Procedure Creator
clear
set stat off
set scor off
set safe off
set talk off
set conf on
set colo to bg+/n,w/g
filename=space(8)
@ 1,0 say "This program allows you to create help screens"
@ 2,0 say "for training purposes. First, you need to choose"
@ 3,0 say "a name for your screen file. It can be no more"
@ 4,0 say "than eight letters long."
@ 5,0 say "Enter the name here:" get filename picture "!!!!!!!!"
read
screenfile=trim(filename)
use screens.trf
copy stru to &screenfile..trf
clos data
bc=.t.
do while bc
clear
set colo to bg+/n,w/g
use &screenfile..trf alias aa
yesno=space(1)
@ 1,0 say "Make a new screen? (Y or N)" get yesno pict "!"
read
if yesno="N"
clos data
exit
else
endif
@ 1,0 clear
appe blank
set colo to gr+/n
@ 24,0 say "Screen Number "+ltrim(str(recno()))
set colo to b+/n
@ 20,22 say "Enter Screen Text in the box above."
set colo to bg+/n,w/g
@ 0, 0 SAY "1"
@ 0, 2 GET aa->LINE1
@ 1, 0 SAY "2"
@ 1, 2 GET aa->LINE2
@ 2, 0 SAY "3"
@ 2, 2 GET aa->LINE3
@ 3, 0 SAY "4"
@ 3, 2 GET aa->LINE4
@ 4, 0 SAY "5"
@ 4, 2 GET aa->LINE5
@ 5, 0 SAY "6"
@ 5, 2 GET aa->LINE6
@ 6, 0 SAY "7"
@ 6, 2 GET aa->LINE7
@ 7, 0 SAY "8"
@ 7, 2 GET aa->LINE8
@ 8, 0 SAY "9"
@ 8, 2 GET aa->LINE9
@ 9, 0 SAY "10"
@ 9, 2 GET aa->LINE10
@ 10, 0 SAY "11"
@ 10, 2 GET aa->LINE11
@ 11, 0 SAY "12"
@ 11, 2 GET aa->LINE12
@ 12, 0 SAY "13"
@ 12, 2 GET aa->LINE13
@ 13, 0 SAY "14"
@ 13, 2 GET aa->LINE14
@ 14, 0 SAY "15"
@ 14, 2 GET aa->LINE15
@ 15, 0 SAY "16"
@ 15, 2 GET aa->LINE16
@ 16, 0 SAY "17"
@ 16, 2 GET aa->LINE17
@ 17, 0 SAY "18"
@ 17, 2 GET aa->LINE18
read
clear
set colo to gr+/n
@ 24,0 say "Screen Number "+ltrim(str(recno()))
set colo to bg+/n,w/g
@ 1, 0 SAY "P1"
@ 1, 3 GET aa->PROMPT1
@ 2, 0 SAY "P2"
@ 2, 3 GET aa->PROMPT2
@ 3, 0 SAY "P3"
@ 3, 3 GET aa->PROMPT3
@ 4, 0 SAY "P4"
@ 4, 3 GET aa->PROMPT4
@ 6, 0 SAY "If Response is:->"
@ 6, 17 GET aa->RESPONSE1
@ 6, 20 SAY "-> Go to Screen Number:"
@ 6, 44 GET aa->LINKER1
@ 7, 2 SAY "If Response is:->"
@ 7, 19 GET aa->RESPONSE2
@ 7, 22 SAY "---->Go to Screen Number:"
@ 7, 48 GET aa->LINKER2
@ 8, 4 SAY "If Response is->"
@ 8, 20 GET aa->RESPONSE3
@ 8, 23 SAY "-------> Go to Screen Number:"
@ 8, 53 GET aa->LINKER3
@ 9, 6 SAY "If Response is->"
@ 9, 22 GET aa->RESPONSE4
@ 9, 25 SAY "---------->Go to Screen Number:"
@ 9, 57 GET aa->LINKER4
@ 10, 8 SAY "If Response is->"
@ 10, 24 GET aa->RESPONSE5
@ 10, 27 SAY "-----------> Go to Screen Number:"
@ 10, 61 GET aa->LINKER5
@ 11, 10 SAY "If Response is->"
@ 11, 26 GET aa->RESPONSE6
@ 11, 29 SAY "------------->Go to Screen Number:"
@ 11, 64 GET aa->LINKER6
@ 12, 12 SAY "If Response is->"
@ 12, 28 GET aa->RESPONSE7
@ 12, 31 SAY "--------------> Go to screen Number:"
@ 12, 68 GET aa->LINKER7
@ 13, 14 SAY "If Response is->"
@ 13, 30 GET aa->RESPONSE8
@ 13, 33 SAY "----------------> Go to Screen Number:"
@ 13, 72 GET aa->LINKER8
@ 14, 16 SAY "If Response is->"
@ 14, 32 GET aa->RESPONSE9
@ 14, 35 SAY "------------------> Go to Screen Number:"
@ 14, 76 GET aa->LINKER9
@ 15, 18 SAY "If Response is->"
@ 15, 34 GET aa->RESPONSE10
@ 15, 37 SAY "------------->Go to Screen Number:"
@ 15, 72 GET aa->LINKER10
@ 17,10 say "Code for Text Color:" get aa->TOPCOLOR
@ 19,10 say "Code for Prompt Color:" get aa->BELOWCOLOR
read
store recno() to fetchit
clos data
clear
yesno=space(1)
@ 1,0 say "Would you like to preview the screen ? (Y or N)";
get yesno picture "!"
read
clear
if yesno="Y"
do while yesno="Y"
clear
use &screenfile..trf alias aa
go fetchit
tc=topcolor
bl=belowcolor
set colo to &tc/n
@ 0, 1 say aa->LINE1
@ 1, 1 say aa->LINE2
@ 2, 1 say aa->LINE3
@ 3, 1 say aa->LINE4
@ 4, 1 say aa->LINE5
@ 5, 1 say aa->LINE6
@ 6, 1 say aa->LINE7
@ 7, 1 say aa->LINE8
@ 8, 1 say aa->LINE9
@ 9, 1 say aa->LINE10
@ 10, 1 say aa->LINE11
@ 11, 1 say aa->LINE12
@ 12, 1 say aa->LINE13
@ 13, 1 say aa->LINE14
@ 14, 1 say aa->LINE15
@ 15, 1 say aa->LINE16
@ 16, 1 say aa->LINE17
@ 17, 1 say aa->LINE18
set colo to &bl/n
@ 18, 5 say aa->PROMPT1
@ 19, 5 say aa->PROMPT2
@ 20, 5 say aa->PROMPT3
@ 21, 5 say aa->PROMPT4
yesno="N"
@ 22,5 say "Would you like to edit the screen?" get yesno;
picture "!"
read
if yesno="Y"
clear
set colo to bg+/n,w/g
set form to screens
edit
set form to prompts
edit
loop
clos data
else
exit
endif
enddo
else
clos data
endif
enddo
return
Procedure Editor
clear
set talk off
set esca on
set conf on
set stat off
set scor off
set colo to bg+/n,w/g
@ 1,0 say "The following training files are available for editing:"
dir *.trf
filename=space(8)
@ 24,0 say "Enter the name of the file to edit:" get filename;
picture "!!!!!!!!"
read
if .not. file('&filename..trf')
do while .not. file('&filename..trf')
@ 24,0 clear
filename=space(8)
? chr(7)
@ 24,0 say "INVALID ENTRY! Try again:" get filename;
picture "!!!!!!!!"
read
enddo
else
endif
findname=trim(filename)
do while .not. eof()
clear
use &findname..trf alias aa
if reccount()=0
return
else
endif
gonum=0
@ 2,0 say "Which screen do you want to edit?" get gonum;
picture "@Z 9999"
@ 3,0 say "(Enter a zero to return to the menu.)"
read
if gonum=0
exit
else
endif
go gonum
set form to screens
edit
set form to prompts
edit
clos data
enddo
clos all
return
Procedure Trainer
clear
set esca off
set stat off
set scor off
set safe off
set talk off
set echo off
set colo to bg+/n,w/g
@ 1,0 say "The following training files are available for view:"
dir *.trf
FILENAME=SPACE(8)
@ 24,0 SAY "Enter the name of the training file you want to view:";
get filename picture "!!!!!!!!"
read
filename=trim(filename)
if .not. file('&filename..trf')
do while .not. file('&filename..trf')
? chr(7)
@ 24,0 clear
filename=space(8)
@ 24,0 say "INVALID NAME! Try again:" get filename picture "!!!!!!!!"
read
if file('&filename..trf')
exit
else
endif
enddo
else
endif
screenfile=trim(filename)
use &screenfile..trf alias aa
if reccount()=0
return
else
endif
go top
do while .not. eof()
tc=topcolor
bl=belowcolor
set colo to &tc/n,w/g
clear
response=space(2)
@ 0, 1 say aa->LINE1
@ 1, 1 say aa->LINE2
@ 2, 1 say aa->LINE3
@ 3, 1 say aa->LINE4
@ 4, 1 say aa->LINE5
@ 5, 1 say aa->LINE6
@ 6, 1 say aa->LINE7
@ 7, 1 say aa->LINE8
@ 8, 1 say aa->LINE9
@ 9, 1 say aa->LINE10
@ 10, 1 say aa->LINE11
@ 11, 1 say aa->LINE12
@ 12, 1 say aa->LINE13
@ 13, 1 say aa->LINE14
@ 14, 1 say aa->LINE15
@ 15, 1 say aa->LINE16
@ 16, 1 say aa->LINE17
@ 17, 1 say aa->LINE18
set colo to &bl/n
@ 18, 5 say aa->PROMPT1
@ 19, 5 say aa->PROMPT2
@ 20, 5 say aa->PROMPT3
@ 21, 5 say aa->PROMPT4
@ 22, 12 say "Enter response here>>>>" get response pict "!!"
@ 23,12 say "Enter a Q to quit."
read
do case
case val(response)>10
? chr(7),chr(7)
loop
case response="1" .and. linker1<>" "
getit = val(linker1)
case response="2" .and. linker2<>" "
getit=val(linker2)
case response="3" .and. linker3<>" "
getit=val(linker3)
case response="4" .and. linker4<>" "
getit=val(linker4)
case response="5" .and. linker5<>" "
getit=val(linker5)
case response="6" .and. linker6<>" "
getit=val(linker6)
case response="7" .and. linker7<>" "
getit=val(linker7)
case response="8" .and. linker8<>" "
getit=val(linker8)
case response="9" .and. linker9<>" "
getit=val(linker9)
case response="10" .and. linker10<>" "
getit=val(linker10)
case response="Q"
exit
otherwise
? chr(7)
response=space(2)
getit=0
loop
endcase
go getit
enddo
clos all
return
